home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE07 / INTERNAL / SERNUM.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-27  |  4.8 KB  |  142 lines
  1. unit SerNum;
  2.  
  3. Interface
  4.  
  5. uses WinProcs, WinTypes;
  6.  
  7. function GetSerialNumber (drive: Byte): LongInt;
  8. function SetSerialNumber (drive: Byte; serNum: LongInt): Bool;
  9.  
  10. Implementation
  11.  
  12. type
  13.     PMIDINFO = ^MIDINFO;
  14.     MIDINFO = record
  15.                   InfoLevel:  Word;
  16.                   SerialNum:  Longint;
  17.                   VolLabel:   array[0..10] of Char;
  18.                   FileSystem: array [0..7] of Char;
  19.               end;
  20.  
  21. var
  22.     R: record     { Real mode call structure }
  23.            di, si, bp, Reserved, bx, dx, cx, ax : Longint;
  24.            Flags, es, ds, fs, gs, ip, sp, ss: Word;
  25.        end;
  26.  
  27. {----------------------------------------------------------------------------}
  28. {    Name:    GetSetMid                                                      }
  29. {    Purpose: Low level code to get or set a MIDINFO data structure for the  }
  30. {             specified drive.  RealModeAX = $6900 for a get and $6901 for a }
  31. {             set operation.                                                 }
  32. {----------------------------------------------------------------------------}
  33.  
  34. function GetSetMid (Drive: Byte; MID: PMIDINFO; RealModeAX: Word): Bool;
  35. var
  36.     Error: Byte;
  37. begin
  38.     { Assume everything ok }
  39.  
  40.     Error := 0;
  41.     GetSetMid := True;
  42.  
  43.     R.ax := RealModeAX;
  44.     R.bx := Drive;
  45.     R.ds := HiWord (Longint (MID));              { Subtle !!! }
  46.     R.dx := LoWord (Longint (MID));
  47.  
  48.     asm
  49.         mov bx, 0021h     { set flags to $00, Real mode interrupt $21 }
  50.         xor cx, cx        { copy 0 words from protected mode stack }
  51.         mov ax, seg R
  52.         mov es, ax        { selector of real mode call structure }
  53.         mov di, offset R  { offset of real mode call structure }
  54.         mov ax, 0300h     { DPMI simulate real mode interrupt }
  55.         int 31h           { do the business }
  56.         jnc @@1           { branch if no error }
  57.         inc Error
  58.     @@1:
  59.     end;
  60.  
  61.     if Error = 1 then GetSetMid := False;
  62. end;
  63.  
  64. {----------------------------------------------------------------------------}
  65. {    Name:    GetMid                                                         }
  66. {    Purpose: Get the MIDINFO record for a specified drive.                  }
  67. {             Uses GetSetMid.  Returns TRUE if successful.                   }
  68. {----------------------------------------------------------------------------}
  69.  
  70. function GetMid (drive: Byte; var mid: MIDINFO): Bool;
  71. var
  72.     p: LongInt;
  73. begin
  74.     { Assume failure }
  75.     GetMid := False;
  76.  
  77.     { Allocate a MIDINFO data structure in DOS address-space }
  78.     p := GlobalDOSAlloc (sizeof (MIDINFO));
  79.  
  80.     if GetSetMid (drive, Ptr (HiWord (p), 0), $6900) then
  81.     begin
  82.         mid := PMIDINFO (Ptr (LoWord (p), 0))^;
  83.         GetMid := True;
  84.     end;
  85.  
  86.     GlobalDOSFree (LoWord (p));
  87. end;
  88.  
  89. {----------------------------------------------------------------------------}
  90. {    Name:    SetMid                                                         }
  91. {    Purpose: Set the MIDINFO record for a specified drive.                  }
  92. {             Uses GetSetMid.  Returns TRUE if successful.                   }
  93. {----------------------------------------------------------------------------}
  94.  
  95. function SetMid (drive: Byte; var mid: MIDINFO): Bool;
  96. var
  97.     p: LongInt;
  98. begin
  99.     { Assume failure }
  100.     SetMid := False;
  101.  
  102.     { Allocate a MIDINFO data structure in DOS address-space }
  103.     p := GlobalDOSAlloc (sizeof (MIDINFO));
  104.     PMIDINFO (Ptr (LoWord (p), 0))^ := mid;
  105.     if GetSetMid (drive, Ptr (HiWord (p), 0), $6901) then SetMid := True;
  106.     GlobalDOSFree (LoWord (p));
  107. end;
  108.  
  109. {----------------------------------------------------------------------------}
  110. {    Name:    GetSerialNumber                                                }
  111. {    Purpose: Get the serial number for a specified drive.                   }
  112. {             If an error occurs, then 0 is returned as the serial number.   }
  113. {----------------------------------------------------------------------------}
  114.  
  115. function GetSerialNumber (drive: Byte): LongInt;
  116. var
  117.     mid: MIDINFO;
  118. begin
  119.     if GetMid (drive, mid) then GetSerialNumber := mid.SerialNum
  120.     else GetSerialNumber := 0;
  121. end;
  122.  
  123. {----------------------------------------------------------------------------}
  124. {    Name:    SetSerialNumber                                                }
  125. {    Purpose: Set the serial number for a specified drive.                   }
  126. {             If no error, TRUE is returned as the function result.          }
  127. {----------------------------------------------------------------------------}
  128.  
  129. function SetSerialNumber (drive: Byte; serNum: LongInt): Bool;
  130. var
  131.     mid: MIDINFO;
  132. begin
  133.     SetSerialNumber := False;
  134.     if GetMid (drive, mid) then
  135.     begin
  136.         mid.SerialNum := serNum;
  137.         SetSerialNumber := SetMid (drive, mid);
  138.     end;
  139. end;
  140.  
  141. end.
  142.